COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(Comment      Loadable answer file for first homework assignment
C00017 ENDMK
C⊗;
(Comment      Loadable answer file for first homework assignment
in cs206, due 19 April 77+ File is <cs206>homwrk+one   )

(comment Foo can be written as a single function that works in one pass;
each successive car of the list is collected on one of two spare arguments,
either the atom list or the nonatom list+ Since these lists are collected
by consing onto the front, they will be backwards+ This is cured by using
reverse on both of them when the original list is exhausted )

(DEFUN FOO (U) (FOO1 U NIL NIL)) 

(DEFUN FOO1 (U ATOMS NONATOMS) 
       (COND ((NULL U) (REVERSE (APPEND NONATOMS ATOMS)))
             ((ATOM (CAR U))
              (FOO1 (CDR U) (CONS (CAR U) ATOMS) NONATOMS))
             (T (FOO1 (CDR U) ATOMS (CONS (CAR U) NONATOMS))))) 

(comment Foo can also be written as two selection functions, one of which
collects only atoms and one which collects only nonatoms+ These functions
are similar to mapcar, but they only collect the results that pass their
test+ I have written them in terms of my own function SELECTCAR+ Note
that by using lambda notation to specifiy the function I could avoid
having to define the NOTATOM function+ )

(DEFUN FOOTWO (U) 
       (APPEND (SELECTCAR U 'ATOM)
               (SELECTCAR U 'NOTATOM))) 

(DEFUN SELECTCAR (U P) 
       (COND ((NULL U) NIL)
             ((P (CAR U)) (CONS (CAR U) (SELECTCAR (CDR U) P)))
             (T (SELECTCAR (CDR U) P)))) 

(DEFUN NOTATOM (U) (NOT (ATOM U))) 

(Comment The vector product problem can be solved by writing two
auxiliary functions, one which multiplies a vector by a constant and
another which adds two vectors+ Since both of these functions are simply
done using mapcar and a similar function for mapping two lists, the 
product function can be written without using any special auxiliary
functions+ Unfortunately, such a solution is hard to read )

(DEFUN PROD (U V) 
       (COND ((NULL U) NIL)
             (T (POLYSUM (SCALPROD (CAR U) V)
                         (CONS 0. (PROD (CDR U) V)))))) 

(DEFUN SCALPROD (S L) 
       (COND ((NULL L) NIL)
             (T (CONS (TIMES S (CAR L)) (SCALPROD S (CDR L)))))) 

(DEFUN POLYSUM (U V) 
       (COND ((NULL U) V)
             ((NULL V) U)
             (T (CONS (PLUS (CAR U) (CAR V))
                      (POLYSUM (CDR U) (CDR V)))))) 


(comment The two versions of element mentioned in class are included here
to play with the results of commons and locations )

(DEFUN ELEM1 (E L) 
       (COND ((NULL L) E)
             ((EQ 'A (CAR L)) (CAR (ELEM1 E (CDR L))))
             (T (CDR (ELEM1 E (CDR L)))))) 

(DEFUN ELEM2 (E L) 
       (COND ((NULL L) E)
             ((EQ 'A (CAR L)) (ELEM2 (CAR E) (CDR L)))
             (T (ELEM2 (CDR E) (CDR L))))) 

(comment Locations can be written by using one extra variable to carry
along the path traversed so far on the search+ Whenever the current
expression matches the original expression, the path is returned as the
result of the computation+ This wins because in normal s-expressions, an
expression cannot be a subexpression of itself+ If an atom is reached 
without a match, you can safely abandon the search since that path has
failed )

(DEFUN LOCATIONS (E U) (LOC1 E U NIL)) 

(DEFUN LOC1 (EXPR SPACE PATH) 
       (COND ((EQUAL EXPR SPACE) (LIST PATH))
             ((ATOM SPACE) NIL)
             (T (APPEND (LOC1 EXPR (CAR SPACE) (CONS 'A PATH))
                        (LOC1 EXPR
                              (CDR SPACE)
                              (CONS 'D PATH)))))) 

(comment One way to write commons is in terms of locations+ One simply
collects all the subexpressions of the expression into one huge list, and
then applies locations to the ones that occur multiple times and haven't
already been done )

(DEFUN COMMONS (U) (COMMONS1 (COLLECTSUBEXPRS U) U NIL)) 

(DEFUN COMMONS1 (EXPRLIST U RESULTS) 
       (COND ((NULL EXPRLIST) (REVERSE RESULTS))
	     (T (COMMONS1 (CDR EXPRLIST)
                          U
                          (COND ((AND (MEMBER (CAR EXPRLIST)
                                              (CDR EXPRLIST))
                                      (NULL (ASSOC (CAR EXPRLIST)
                                                   RESULTS)))
                                 (CONS (CONS (CAR EXPRLIST)
                                             (LOCATIONS (CAR EXPRLIST)
                                                       U))
                                       RESULTS))
                                (T RESULTS)))))) 

(DEFUN COLLECTSUBEXPRS (U) 
       (COND ((ATOM U) NIL)
             (T (APPEND (CONS (CAR U) (COLLECTSUBEXPRS (CAR U)))
                        (CONS (CDR U) (COLLECTSUBEXPRS (CDR U))))))) 


(comment Another way to do commons is shown here as commontwo; Commall
goes through collecting all the subexpressions and their associated
paths, then collectall gos around mashing together all the ones that
occur more than once into the appropriate format for the answer )

(DEFUN COMMONTWO (U) (CUMMUNS (COMMALL U NIL) NIL)) 

(DEFUN COMMALL (U PATH) 
       (COND ((ATOM U) (LIST (LIST U PATH)))
             (T (APPEND (LIST (LIST U PATH))
                        (COMMALL (CAR U) (CONS 'A PATH))
                        (COMMALL (CDR U) (CONS 'D PATH)))))) 

(DEFUN CUMMUNS (BIGLIST RESULTS) 
       (COND
        ((NULL BIGLIST) RESULTS)
        ((OR (ASSOC (CAAR BIGLIST) RESULTS)
             (NOT (ASSOC (CAAR BIGLIST) (CDR BIGLIST))))
         (CUMMUNS (CDR BIGLIST) RESULTS))
        (T (CUMMUNS (CDR BIGLIST)
                    (APPEND RESULTS
                            (LIST (CONS (CAAR BIGLIST)
                                        (COLLECTALL (CAAR BIGLIST)
                                                    BIGLIST)))))))) 

(DEFUN COLLECTALL (EXPR SOURCE) 
       (COND ((NULL SOURCE) NIL)
             ((EQUAL EXPR (CAAR SOURCE))
              (CONS (CADAR SOURCE) (COLLECTALL EXPR (CDR SOURCE))))
             (T (COLLECTALL EXPR (CDR SOURCE)))))